home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -seriously_amiga- / programming / other / scm / slib / fluidlet.scm < prev    next >
Text File  |  1999-04-19  |  1KB  |  41 lines
  1. ; "fluidlet.scm", FLUID-LET for Scheme
  2. ; Copyright (c) 1998, Aubrey Jaffer
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20. (require 'dynamic-wind)
  21. (require 'common-list-functions)    ;MAKE-LIST
  22.  
  23. (defmacro fluid-let (clauses . body)
  24.   (let ((ids (map car clauses))
  25.     (new-tmps (map (lambda (x) (gentemp)) clauses))
  26.     (old-tmps (map (lambda (x) (gentemp)) clauses)))
  27.     `(let (,@(map list new-tmps (map cadr clauses))
  28.        ,@(map list old-tmps (make-list (length clauses) #f)))
  29.        (dynamic-wind
  30.        (lambda ()
  31.          ,@(map (lambda (ot id) `(set! ,ot ,id))
  32.             old-tmps ids)
  33.          ,@(map (lambda (id nt) `(set! ,id ,nt))
  34.             ids new-tmps))
  35.        (lambda () ,@body)
  36.        (lambda ()
  37.          ,@(map (lambda (nt id) `(set! ,nt ,id))
  38.             new-tmps ids)
  39.          ,@(map (lambda (id ot) `(set! ,id ,ot))
  40.             ids old-tmps))))))
  41.